Shareware Grab Bag/Shareware Grab Bag.iso/005/pccheck.arc/PC-CHECK.PAS

Pascal/Delphi Source File | 1984-09-18 | 46.7 KB | 1,303 lines

Program PC_Check;

{$C-}

{      PC-Check Copyright (c)  The Forbin Project and John Friel III

       PC-Check  is a checkbook and  savings  record  keeper  produced
       by the  Forbin  Project.   Like some public domain software, we
       are asking  for a  donation  for  the use  of this program.   A
       donation of  only $5.00  is requested.   Those that  do  donate
       will  receive  published announcements  for future enhancements
       to  PC-Check  and other programs written by the Forbin Project.
       PC-Check  may  be  transferred  to  other people  under two (2)
       conditions;  that there is  NO CHARGE  for the copy(s) and that
       the source program  not be modified in  any way, shape or form.
       The user  may  modify  the source code  to suit his  or her own
       personal tastes.    All rights reserved by the  Forbin Project.
       Please keep an unmodified  copy  around just for  this purpose.
       For  more  information  on  this  program  or   more   detailed
       information  on interfacing  TURBO Pascal  with the  IBM PC  or
       Compatibles, (this was developed on a Tava PC!) please write to
       the Forbin Project at :

                          The Forbin Project
                          John Friel III
                          715 Walnut Street
                          Cedar Falls, Iowa  50613
}

Const
  blink_yes        = true;
  blink_no         = false;
  yes_no           : set of char = ['Y','y','N','n'];
  filechars        : set of char = ['A'..'Z','a'..'z','0'..'9',':',
                                    '!','$','@','#','%','-','&'];

type
  check_trans  = (cdeposit, cwithdrawl, cinterest,
                  sdeposit, swithdrawl, sinterest);
  check_type   = record
                   post_date : string[8];
                   check_no  : integer;
                   to_who    : string[40];
                   amount    : real;
                   memo      : string[30];
                   check_tran: check_trans;
                   cleared   : boolean;
                 end;
  Names            = String[80];
  Screen_Array     = Array [1..4000] of byte;
  months           = 1..12;
  days             = 1..31;
  years            = 0..99;
  xxxstr80         = string[80];
  xxxstr8          = string[8];
  xxxfile          = file;

Var
  n_amount,temp_date            : string[8];
  n_check_num                   : string[5];
  new_amount, amount_h          : real;
  t_cdc, t_cwc, t_cic,
  t_sdc, t_swc, t_sic,
  t_cdu, t_cwu, t_ciu,
  t_sdu, t_swu, t_siu,
  tcc, tcs, rbs, rbc            : real;
  rc, check_num_h               : integer;
  trnfile                       : file of check_type;
  one_trn                       : check_type;
  x, i, y, q, e, w, check_num,
  crt_reg, z                    : Integer;
  to_whom, to_who_h             : string[40];
  new_memo, memo_h              : string[30];
  Ok, bool, done, edit_ok       : Boolean;
  FileName                      : Names;
  Real_Screen                   : Screen_Array absolute $B800:$0000;
  Temp_Screen, temp_Screen2     : Screen_Array;
  Ch, ch1,ch2                   : Char;
  check_tran_h                  : check_trans;


procedure screen_off;
begin
  crt_reg := $c;
  port[$3d4] := crt_reg;
  z := port[$3d5];
  port[$3d4] := crt_reg;
  port[$3d5] := $8;
end;


procedure screen_on;
begin
  port[$3d4] := crt_reg;
  port[$3d5] := z;
end;



function readdate(x,y:integer; indate:xxxstr8):xxxstr8;
{  reads a string from the terminal from screen at position xy  }
{    the string will contain a Valid date in format 00/00/00  }
Var
   hold : array [1..6] of char;
   location : integer;
   inchar : char;

begin
   location := 1;
   gotoxy(x,y);
   if indate = '' then
     write('MM/DD/YY')
   else
     write(indate);
   gotoxy(x,y);
   while location<8 do
      begin
         read(kbd,inchar);
         case location of
            1:
               begin
                  gotoxy(x,y);
                  if inchar in ['1','0',' '] then
                     begin
                        hold[1] := inchar;
                        write(inchar);
                        location := 2;
                        gotoxy((x+1),y);
                     end
                  else
                     begin
                        write(chr(7));
                     end;
               end;
            2:
               begin
                  gotoxy((x+1),y);
                  if inchar in ['1'..'9','0'] then
                     if hold[1]='1' then
                        if inchar in ['1','2','0'] then
                           begin
                              hold[2] := inchar;
                              write(inchar);
                              location := 3;
                           end
                        else
                           begin
                              write(chr(7));
                           end
                     else
                        begin
                           write(inchar);
                           hold[2] := inchar;
                           location := 3;
                        end
                  else
                     if ((inchar = chr(8)) or (inchar = chr(7))) then
                        begin
                           gotoxy(x,y);
                           write(' ');
                           location := 1;
                           hold[1] := ' ';
                           gotoxy(x,y);
                        end
                     else
                        begin
                           write(chr(7));
                        end;
               end;
            3:
               begin
                  gotoxy((x+3),y);
                  if inchar in ['1'..'3','0',' '] then
                     begin
                        hold[3] := inchar;
                        write(inchar);
                        location := 4;
                        gotoxy((x+4),y);
                     end
                  else
                     if ((inchar = chr(8)) or (inchar = chr(7))) then
                        begin
                           gotoxy((x+1),y);
                           write(' ');
                           location := 2;
                           hold[2] := ' ';
                           gotoxy((x+1),y);
                        end
                     else
                        begin
                           write(chr(7));
                        end;
               end;
            4:
               begin
                  gotoxy((x+4),y);
                  if inchar in ['1'..'9','0'] then
                     begin
                        hold[4] := inchar;
                        write(inchar);
                        location := 5;
                        gotoxy((x+6),y);
                     end
                  else
                     if ((inchar = chr(8)) or (inchar = chr(7))) then
                        begin
                           gotoxy((x+3),y);
                           write(' ');
                           location := 3;
                           hold[3] := ' ';
                           gotoxy((x+3),y);
                        end
                     else
                        begin
                           write(chr(7));
                        end;
               end;
            5:
               begin
                  gotoxy((x+6),y);
                  if inchar in ['1'..'9','0'] then
                     begin
                        hold[5] := inchar;
                        write(inchar);
                        location := 6;
                        gotoxy((x+7),y);
                     end
                  else
                     if ((inchar = chr(8)) or (inchar = chr(7))) then
                        begin
                           gotoxy((x+4),y);
                           write(' ');
                           location := 4;
                           hold[4] := ' ';
                           gotoxy((x+4),y);
                        end
                     else
                        begin
                           write(chr(7));
                        end;
               end;
            6:
               begin
                  gotoxy((x+7),y);
                  if inchar in ['1'..'9','0'] then
                     begin
                        hold[6] := inchar;
                        write(inchar);
                        location := 7;
                     end
                  else
                     if ((inchar = chr(8)) or (inchar = chr(7))) then
                        begin
                           gotoxy((x+6),y);
                           write(' ');
                           location := 5;
                           hold[5] := ' ';
                           gotoxy((x+6),y);
                        end
                     else
                        begin
                           write(chr(7));
                        end;
               end;
            7:
               begin
                  if ((inchar=chr(11)) or (inchar=chr(13))) then
                     location := 8
                  else
                     if ((inchar=chr(8)) or (inchar=chr(7))) then
                        begin
                           gotoxy((x+7),y);
                           write(' ');
                           location := 6;
                           hold[6] := ' ';
                           gotoxy((x+7),y);
                        end;
               end;
         end;
      end;
   readdate := hold[1]+hold[2]+'/'+hold[3]+hold[4]+'/'+hold[5]+hold[6];
end;


Procedure Big_exit;
begin
  close (trnfile);
  textbackground(black);
  textcolor(yellow);
  window (1,1,80,25);
  for x := 10 downto 1 do
    for y := 2 downto 1 do
      begin
        window (x+y-1,x+4,82-x-y,25-x);
        clrscr;
        delay (5);
      end;
  gotoxy (29,12);
  write ('PC-Check has Completed.');
  halt;
end;

Procedure Drawbox_IBM (x1,y1,x2,y2,FG,BG : Integer; boxname : Names; blnk : boolean);
Begin
  window (x1,y1,x2,y1+1);
  textbackground(BG);
  GotoXY(1,1);
  x := x2-x1;
  if length(boxname) > x then boxname[0] := chr(x-4);
  textcolor(FG);
  Write('╒');
  if blnk then textcolor(FG + blink) else textcolor(fg);
  write (boxname);
  textcolor(FG);
  for q := x1+length(boxname)+1 to x2-1 do Write('═');
  Write('╕');
  for q := 2 to y2-y1 do
    Begin
      window (x1,y1,x2,y1+q+1);
      GotoXY(1,q); Write('│');
      if blnk then clreol;
      GotoXY(x2-x1+1,q); Write('│');
    end;
  Window(x1,y1,x2,y2+1);
  gotoXY(1,y2-y1+1);
  Write('╘');
  for q := x1+1 to x2-1 do Write('═');
  Write('╛');
end;

Procedure Drawbox (x1,y1,x2,y2,FG,BG : Integer; boxname : Names; blnk : boolean);
Begin
  Drawbox_IBM (x1,y1,x2,y2,FG,BG,boxname,blnk);
  Window (x1+1,y1+1,x2-1,y2-1);
  Clrscr;
end;


Procedure Init;
Begin
  textcolor(white);
  done := False;
  Window (1,1,80,25);
  ClrScr;
  Drawbox (1,1,80,4,lightgreen,black,'',blink_yes);
  textcolor(yellow);
  assign (trnfile,'dummy');
  Writeln ('                              PC-Check  v1.1');
  Write   ('     (c) The Forbin Project   1 September 1984   Using TURBO Pascal');
end;

procedure open_files;
var
  file_ok,colon : boolean;
begin
  Drawbox (1,5,80,14,yellow,red,'[ File Allocation ]',blink_yes);
  close (trnfile);
  repeat
    writeln;
    write  ('Enter Transaction file name  (x:xxxxxxxx)  ');
    buflen := 10;
    readln (filename);
    file_ok := true;
    colon := false;
    ok := false;
    for q := 1 to length(filename) do
      begin
        if not (filename[q] in filechars) then
          file_ok := false;
        if (filename[q] = ':') and (q <> 2) then
          file_ok := false;
        if filename[q] = ':' then colon := true;
      end;
    if (not colon) and (length(filename) > 8) then file_ok := false;
    if colon and (length(filename) < 3) then file_ok := false;
    if (length(filename) <> 0) and file_ok then
      begin
        filename := filename + '.CHK';
        assign (trnfile, filename);
        {$I-} reset (trnfile); {$I+}
        ok := (ioresult = 0);
        if not ok then
          begin
            write ('File does not exist. create it  (Y/N) ? ');
            repeat
              read (kbd, ch);
            until ch in yes_no;
            if ch in ['Y','y'] then
              begin
                ok := true;
                rewrite (trnfile);
              end
          end;
      end
    else
      begin
        ok := false;
        write ('Invalid filename. Do you want to Quit ? ');
        repeat read (kbd, ch); until ch in yes_no;
        if ch in ['Y','y'] then big_exit;
        writeln;
      end;
  until ok;
  Drawbox_ibm (1,5,80,14,yellow,red,'[ File Allocation ]',blink_no);
end;

procedure CD;
begin
  Drawbox (1,5,80,14,lightgreen,black,'[ Checking Deposit ]',blink_yes);
  repeat
    textcolor (white);
    gotoxy (5,1);   write ('Date');
    gotoxy (5,3);  write ('Amount ________');
    gotoxy (5,5);   write ('Memo ______________________________');
    { get date }
    textcolor (lightcyan);
    repeat
      temp_date := readdate(10,1,'');
      { get amount }
      repeat
        gotoxy (12,3);  buflen := 8;  readln (n_amount);
        val (n_amount, new_amount, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error in Amount at position ',rc:1);
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      { get memo }
      gotoxy (10,5);  buflen := 30; readln (new_memo);
      while length(new_memo) < 30 do new_memo := new_memo + ' ';
      gotoxy (5,7);   write ('Is this deposit right  (Y/N)  ');
      repeat
        read (kbd, ch);
      until ch in yes_no;
      case ch of
        'N','n'  :  begin
                      gotoxy (5,7); clreol;
                      write ('Do you want to EXIT (Y/N) ? ');
                      repeat
                        read (kbd, ch1);
                      until ch1 in yes_no;
                    end;
        'Y','y'  :  ch1 := 'N';
      end; { case }
    until (ch in ['Y','y']) or (ch1 in ['Y','y']);
    if ch in ['Y','y'] then
      begin
        with one_trn do
          begin
            post_date := temp_date;
            check_no  := 0;
            to_who    := '                                         ';
            amount    := new_amount;
            memo      := new_memo;
            check_tran := cdeposit;
            cleared    := false;
          end; { with }
        seek (trnfile, filesize(trnfile));
        write (trnfile, one_trn);
      end;
    gotoxy (5,7); clreol;
    write ('Do you want to EXIT (Y/N)  ');
    repeat
      read (kbd, ch1);
    until ch1 in yes_no;
  until ch1 in ['y','Y'];
end;

procedure CW;
begin
  Drawbox (1,5,80,14,lightgreen,black,'[ Checking Withdrawl  --  Blank Check ]',blink_yes);
  repeat
    textcolor (white);
    gotoxy (5,1);   write ('Date');
    gotoxy (60,1);  write ('Check Number _____');
    gotoxy (5,3);   write ('Pay to ________________________________________');
    gotoxy (60,3);  write ('Amount ________');
    gotoxy (5,5);   write ('Memo ______________________________');
    { get date }
    textcolor (lightcyan);
    repeat
      temp_date := readdate(10,1,'');
      { get check number }
      repeat
        gotoxy (73,1);  buflen := 5;  readln (n_check_num);
        val (n_check_num, check_num, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error : Numeric input only.');
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      { get to_who }
      gotoxy (12,3);  buflen := 40; readln (to_whom);
      { get amount }
      repeat
        gotoxy (67,3);  buflen := 8;  readln (n_amount);
        val (n_amount, new_amount, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error in Amount at position ',rc:1);
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      { get memo }
      gotoxy (10,5);  buflen := 30; readln (new_memo);
      while length(new_memo) < 30 do new_memo := new_memo + ' ';
      while length(to_whom) < 40 do to_whom := to_whom + ' ';
      gotoxy (5,7);   write ('Is this check right  (Y/N)  ');
      repeat
        read (kbd, ch);
      until ch in yes_no;
      case ch of
        'N','n'  :  begin
                      gotoxy (5,7);
                      write ('Do you want to EXIT (Y/N)  ');
                      repeat
                        read (kbd, ch1);
                      until ch1 in yes_no;
                    end;
        'Y','y'  :  ch1 := 'N';
      end; { case }
    until (ch in ['Y','y']) or (ch1 in ['Y','y']);
    if ch in ['Y','y'] then
      begin
        with one_trn do
          begin
            post_date := temp_date;
            check_no  := check_num;
            to_who    := to_whom;
            amount    := new_amount;
            memo      := new_memo;
            check_tran := cwithdrawl;
            cleared    := false;
          end; { with }
        seek (trnfile, filesize(trnfile));
        write (trnfile, one_trn);
      end;
    gotoxy (5,7);
    write ('Do you want to EXIT (Y/N)  ');
    repeat
      read (kbd, ch1);
    until ch1 in yes_no;
  until ch1 in ['y','Y'];
end;

procedure CI;
begin
  Drawbox (1,5,80,14,lightgreen,black,'[ Checking Interest Deposit ]',blink_yes);
  repeat
    textcolor (white);
    gotoxy (5,1);  write ('Date');
    gotoxy (5,3);  write ('Amount ________');
    { get date }
    textcolor (lightcyan);
    repeat
      temp_date := readdate(10,1,'');
      { get amount }
      repeat
        gotoxy (12,3);  buflen := 8;  readln (n_amount);
        val (n_amount, new_amount, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error in Amount at position ',rc:1);
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      gotoxy (5,7);   write ('Is this right  (Y/N)  ');
      repeat
        read (kbd, ch);
      until ch in yes_no;
      case ch of
        'N','n'  :  begin
                      gotoxy (5,7);
                      write ('Do you want to EXIT (Y/N)  ');
                      repeat
                        read (kbd, ch1);
                      until ch1 in yes_no;
                    end;
        'Y','y'  :  ch1 := 'N';
      end; { case }
    until (ch in ['Y','y']) or (ch1 in ['Y','y']);
    if ch in ['Y','y'] then
      begin
        with one_trn do
          begin
            post_date := temp_date;
            check_no  := 0;
            to_who    := '                                         ';
            amount    := new_amount;
            memo      := 'Checking Interest              ';
            check_tran := cinterest;
            cleared    := false;
          end; { with }
        seek (trnfile, filesize(trnfile));
        write (trnfile, one_trn);
      end;
    gotoxy (5,7);
    write ('Do you want to EXIT (Y/N)  ');
    repeat
      read (kbd, ch1);
    until ch1 in yes_no;
  until ch1 in ['y','Y'];
end;

procedure SD;
begin
  Drawbox (1,5,80,14,lightgreen,black,'[ Savings Deposit ]',blink_yes);
  repeat
    textcolor (white);
    gotoxy (5,1);   write ('Date');
    gotoxy (5,3);   write ('Amount ________');
    gotoxy (5,5);   write ('Memo ______________________________');
    { get date }
    textcolor (lightcyan);
    repeat
      temp_date := readdate(10,1,'');
      { get amount }
      repeat
        gotoxy (12,3);  buflen := 8;  readln (n_amount);
        val (n_amount, new_amount, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error in Amount at position ',rc:1);
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      { get memo }
      gotoxy (10,5);  buflen := 30; readln (new_memo);
      while length(new_memo) < 30 do new_memo := new_memo + ' ';
      gotoxy (5,7);   write ('Is this deposit right  (Y/N)  ');
      repeat
        read (kbd, ch);
      until ch in yes_no;
      case ch of
        'N','n'  :  begin
                      gotoxy (5,7); clreol;
                      write ('Do you want to EXIT (Y/N) ? ');
                      repeat
                        read (kbd, ch1);
                      until ch1 in yes_no;
                    end;
        'Y','y'  :  ch1 := 'N';
      end; { case }
    until (ch in ['Y','y']) or (ch1 in ['Y','y']);
    if ch in ['Y','y'] then
      begin
        with one_trn do
          begin
            post_date := temp_date;
            check_no  := 0;
            to_who    := '                                         ';
            amount    := new_amount;
            memo      := new_memo;
            check_tran := sdeposit;
            cleared    := false;
          end; { with }
        seek (trnfile, filesize(trnfile));
        write (trnfile, one_trn);
      end;
    gotoxy (5,7); clreol;
    write ('Do you want to EXIT (Y/N)  ');
    repeat
      read (kbd, ch1);
    until ch1 in yes_no;
  until ch1 in ['y','Y'];
end;

procedure SW;
begin
  Drawbox (1,5,80,14,lightgreen,black,'[ Savings Withdrawl ]',blink_yes);
  repeat
    textcolor (white);
    gotoxy (5,1);   write ('Date');
    gotoxy (5,3);   write ('Amount ________');
    gotoxy (5,5);   write ('Memo ______________________________');
    { get date }
    textcolor (lightcyan);
    repeat
      temp_date := readdate(10,1,'');
      { get amount }
      repeat
        gotoxy (12,3);  buflen := 8;  readln (n_amount);
        val (n_amount, new_amount, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error in Amount at position ',rc:1);
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      { get memo }
      gotoxy (10,5);  buflen := 30; readln (new_memo);
      while length(new_memo) < 30 do new_memo := new_memo + ' ';
      gotoxy (5,7);   write ('Is this deposit right  (Y/N)  ');
      repeat
        read (kbd, ch);
      until ch in yes_no;
      case ch of
        'N','n'  :  begin
                      gotoxy (5,7); clreol;
                      write ('Do you want to EXIT (Y/N) ? ');
                      repeat
                        read (kbd, ch1);
                      until ch1 in yes_no;
                    end;
        'Y','y'  :  ch1 := 'N';
      end; { case }
    until (ch in ['Y','y']) or (ch1 in ['Y','y']);
    if ch in ['Y','y'] then
      begin
        with one_trn do
          begin
            post_date := temp_date;
            check_no  := 0;
            to_who    := '                                         ';
            amount    := new_amount;
            memo      := new_memo;
            check_tran := swithdrawl;
            cleared    := false;
          end; { with }
        seek (trnfile, filesize(trnfile));
        write (trnfile, one_trn);
      end;
    gotoxy (5,7); clreol;
    write ('Do you want to EXIT (Y/N)  ');
    repeat
      read (kbd, ch1);
    until ch1 in yes_no;
  until ch1 in ['y','Y'];
end;

procedure SI;
begin
  Drawbox (1,5,80,14,lightgreen,black,'[ Savings Interest ]',blink_yes);
  repeat
    textcolor (white);
    gotoxy (5,1);   write ('Date');
    gotoxy (5,3);   write ('Amount ________');
    gotoxy (5,5);   write ('Memo ______________________________');
    { get date }
    textcolor (lightcyan);
    repeat
      temp_date := readdate(10,1,'');
      { get amount }
      repeat
        gotoxy (12,3);  buflen := 8;  readln (n_amount);
        val (n_amount, new_amount, rc);
        if rc <> 0 then
          begin
            gotoxy (5,7);
            writeln ('Error in Amount at position ',rc:1);
          end;
      until rc = 0;
      gotoxy (5,7); clreol;
      { get memo }
      gotoxy (10,5);  buflen := 30; readln (new_memo);
      while length(new_memo) < 30 do new_memo := new_memo + ' ';
      gotoxy (5,7);   write ('Is this deposit right  (Y/N)  ');
      repeat
        read (kbd, ch);
      until ch in yes_no;
      case ch of
        'N','n'  :  begin
                      gotoxy (5,7); clreol;
                      write ('Do you want to EXIT (Y/N) ? ');
                      repeat
                        read (kbd, ch1);
                      until ch1 in yes_no;
                    end;
        'Y','y'  :  ch1 := 'N';
      end; { case }
    until (ch in ['Y','y']) or (ch1 in ['Y','y']);
    if ch in ['Y','y'] then
      begin
        with one_trn do
          begin
            post_date := temp_date;
            check_no  := 0;
            to_who    := '                                         ';
            memo      := new_memo;
            amount    := new_amount;
            check_tran := sinterest;
            cleared    := false;
          end; { with }
        seek (trnfile, filesize(trnfile));
        write (trnfile, one_trn);
      end;
    gotoxy (5,7); clreol;
    write ('Do you want to EXIT (Y/N)  ');
    repeat
      read (kbd, ch1);
    until ch1 in yes_no;
  until ch1 in ['y','Y'];
end;

procedure Balance_sheet;    { the CHK file will be closed and reopened }
var
   tt : integer;
begin
  tt := 0;
  t_cdc := 0.0; t_cwc := 0.0; t_cic := 0.0; t_sdc := 0.0;
  t_swc := 0.0; t_sic := 0.0; t_cdu := 0.0; t_cwu := 0.0;
  t_ciu := 0.0; t_sdu := 0.0; t_swu := 0.0; t_siu := 0.0;
  tcc   := 0.0; tcs   := 0.0; rbs   := 0.0; rbc   := 0.0;
  move (real_screen, temp_screen, 4000);
  drawbox (2,6,79,23,white,black,'[ Balance Sheet ]',blink_yes);
  gotoxy (27,2); write ('Deposits          Withdrawls          Interest');
  gotoxy (1,3);  write ('Cleared');
  gotoxy (3,4);  write ('Checking');
  gotoxy (3,5);  write ('Savings');
  gotoxy (1,7);  write ('Uncleared');
  gotoxy (3,8);  write ('Checking');
  gotoxy (3,9); write ('Savings');
  gotoxy (25,11); write ('Checking            Savings');
  gotoxy (3,13);  write ('Total Cleared');
  gotoxy (4,14);  write ('Real Balance');
  textcolor (lightgreen);
  close (trnfile);                 { save buffered transactions }
  assign (trnfile, filename);
  reset (trnfile);
  while not eof(trnfile) do
    begin
      read (trnfile, one_trn);
      case one_trn.check_tran of
        cdeposit    : if one_trn.cleared then
                        t_cdc := t_cdc + one_trn.amount
                      else
                        t_cdu := t_cdu + one_trn.amount;
        cwithdrawl  : if one_trn.cleared then
                        t_cwc := t_cwc + one_trn.amount
                      else
                        t_cwu := t_cwu + one_trn.amount;
        cinterest   : if one_trn.cleared then
                        t_cic := t_cic + one_trn.amount
                      else
                        t_ciu := t_ciu + one_trn.amount;
        sdeposit    : if one_trn.cleared then
                        t_sdc := t_sdc + one_trn.amount
                      else
                        t_sdu := t_sdu + one_trn.amount;
        swithdrawl  : if one_trn.cleared then
                        t_swc := t_swc + one_trn.amount
                      else
                        t_swu := t_swu + one_trn.amount;
        sinterest   : if one_trn.cleared then
                        t_sic := t_sic + one_trn.amount
                      else
                        t_siu := t_siu + one_trn.amount;
      end; { case }
      tt := tt + 1;
    end; { while }
  tcc := t_cdc + t_cic - t_cwc;
  tcs := t_sdc + t_sic - t_swc;
  rbc := tcc + t_cdu + t_ciu - t_cwu;
  rbs := tcs + t_sdu + t_siu - t_swu;
  { now locate the totals on the screen }
  gotoxy (25,4); write (t_cdc:8:2,'           ',t_cwc:8:2,'           ',t_cic:8:2);
  gotoxy (25,5); write (t_sdc:8:2,'           ',t_swc:8:2,'           ',t_sic:8:2);
  gotoxy (25,8); write (t_cdu:8:2,'           ',t_cwu:8:2,'           ',t_ciu:8:2);
  gotoxy (25,9); write (t_sdu:8:2,'           ',t_swu:8:2,'           ',t_siu:8:2);
  if tcc < 0 then textcolor (lightred);
  gotoxy (25,13); write (tcc:8:2);
  textcolor (lightgreen);
  if tcs < 0 then textcolor (lightred);
  gotoxy (44,13); write (tcs:8:2);
  textcolor (lightgreen);
  if rbc < 0 then textcolor (lightred);
  gotoxy (25,14); write (rbc:8:2);
  textcolor (lightgreen);
  if rbs < 0 then textcolor (lightred);
  gotoxy (44,14); write (rbs:8:2);
  textcolor (lightblue);
  gotoxy (5,16);  write ('Total Transaction = ',tt:4);
  gotoxy (40,16); write ('Press any key to Return ');
  read (kbd,ch);
  move (temp_screen, real_screen, 4000);
end;

procedure add_a_trn;
begin
  repeat
    Drawbox (1,5,80,14,white,blue,'[ Transaction Menu ]',blink_yes);
    writeln;
    writeln ('Options:');
    writeln ('        1)  Checking Deposit            4)  Savings Deposit');
    writeln ('        2)  Checking Withdrawl          5)  Savings Withdrawl');
    writeln ('        3)  Checking Interest           6)  Savings Interest');
    writeln ('                                        7)  Exit');
    write   ('                 Choice? ');
    repeat
      read (kbd, ch);
    until ch in ['1'..'7'];
    case ch of
      '1'   :  CD;
      '2'   :  CW;
      '3'   :  CI;
      '4'   :  SD;
      '5'   :  SW;
      '6'   :  SI;
    end
  until ch = '7';
  Drawbox_ibm (1,5,80,14,white,blue,'[ Transaction Menu ]',blink_no);
end;

procedure Clear_entries;
var
  tt, tc : integer;
begin
  tt := 0;  tc := 0;
  move (real_screen, temp_screen, 4000);
  drawbox (2,6,79,20,yellow,blue,'[ Clear Transactions ]',blink_yes);
  close (trnfile);
  assign (trnfile, filename);
  reset (trnfile);
  writeln ('    For every transaction displayed, ');
  writeln ('    press ''Y'', ''N'' or ''Q''');
  while not eof(trnfile) do
    begin
      read (trnfile, one_trn);
      tt := tt + 1;
      if not one_trn.cleared then
        begin
          gotoxy (20,5);
          case one_trn.check_tran of
            cdeposit  :  write ('Checking Deposit     ');
            cwithdrawl  :  write ('Checking Withdrawl');
            cinterest   :  write ('Checking Interest ');
            sdeposit    :  write ('Savings Deposit   ');
            swithdrawl  :  write ('Savings Withdrawl ');
            sinterest   :  write ('Savings Interest  ');
          end;  { case }
          gotoxy (20,6);  write ('Posting Date : ',one_trn.post_date);
          gotoxy (20,7);  write ('Check No.    : ',one_trn.check_no:5);
          gotoxy (20,8);  write ('Written to   : ',one_trn.to_who);
          gotoxy (20,9);  write ('Amount       : ',one_trn.amount:8:2);
          gotoxy (20,10); write ('Memo         : ',one_trn.memo);
          gotoxy (10,12); write ('Has this Cleared  [Yes, No, Quit] ? ');
          repeat read (kbd, ch); until ch in yes_no + ['Q','q'];
          if ch in ['Y','y'] then
            begin
              tc := tc + 1;
              one_trn.cleared := true;
              seek (trnfile, tt-1);
              write (trnfile, one_trn);
            end
          else
            if ch in ['Q','q'] then
               while not eof(trnfile) do
                 begin
                   read (trnfile, one_trn);
                   tt := tt + 1;
                 end;
        end;
    end; { while }
  clrscr;
  writeln;
  writeln ('    Total Transactions = ',tt:5);
  writeln ('    Total Cleared      = ',tc:5);
  write   ('    Press any key to Return ');
  read (kbd,ch);
  move (temp_screen, real_screen, 4000);
end;  { clear_entries }

procedure Summary;
var
  tt, tc : integer;
begin
  tt := 0;  tc := 1;
  move (real_screen, temp_screen, 4000);
  drawbox (8,10,66,17,white,green,'[ Summary Print ]',blink_yes);
  flush (trnfile);
  reset (trnfile);
  writeln;
  writeln ('    Make sure your Printer is ON.');
  writeln ('    Press ''Y'' to continue or any other key to Exit');
  read (kbd, ch);
  writeln;
  if ch in ['Y','y'] then
    begin
      textcolor (yellow);
      writeln ('    Printing Transaction File.');
      write   ('    Press any key to Abort.');
      writeln (lst,#15,#27,#85);
      while not eof(trnfile) do
        begin
          if tt = 0 then
            begin
              for x := 1 to 3 do writeln (lst,'');
              writeln (lst,'                     PC-Check  Summary sheet for transaction file ',filename,'      Page ',tc:2);
              writeln (lst,'');
              write   (lst,'Code    Cleared   Tran Date          Written                                Reason');
              writeln (lst,'                         Amount   Check No.');
              writeln (lst,'');
              tt := 7;
            end;
          read (trnfile, one_trn);
          tt := tt + 1;
          write (lst,'  ');
          case one_trn.check_tran of
            cdeposit   : write (lst,'CD ');
            cwithdrawl : write (lst,'CW ');
            cinterest  : write (lst,'CI ');
            sdeposit   : write (lst,'SD ');
            swithdrawl : write (lst,'SW ');
            sinterest  : write (lst,'SI ');
          end;  { case }
          if one_trn.cleared then
            write (lst,'     Y')
          else
            write (lst,'     N');
          write (lst,'       ',one_trn.post_date:8);
          write (lst,'    ',one_trn.to_who:40);
          write (lst,'  ',one_trn.memo:30);
          write (lst,'  ',one_trn.amount:8:2);
          write (lst,'    ',one_trn.check_no:5);
          writeln (lst,'');
          if tt = 62 then
            begin
              for x := 1 to 4 do writeln (lst,'');
              tc := tc + 1;
              tt := 0;
            end;
          if keypressed then
            begin
              read (kbd, ch);
              seek (trnfile, filesize(trnfile));
            end;
      end; { while }
    end;
  move (temp_screen, real_screen, 4000);
end;

procedure Browse;
var
  tt, tc : integer;
begin
  tt := 0;  tc := 1;
  edit_ok := false;
  move (real_screen, temp_screen, 4000);
  drawbox (2,10,79,23,white,black,'[ Browse Transaction File  -- ' + filename + ']',blink_yes);
  flush (trnfile);
  reset (trnfile);
  tt := filesize(trnfile);
  textcolor (yellow);
  if tt = 0 then
    begin
      writeln;
      gotoxy (20,5); writeln ('     The file is Empty!');
      gotoxy (20,6); write   ('     Press any key to Return ');
      repeat until keypressed;
      read (kbd, ch);
    end
  else
    begin
      writeln ('    Valid keys are -');
      writeln ('    (F)irst (L)ast (N)ext (P)revious (Q)uit (E)dit');
      writeln ('    (+) Skip 10 Forward   (-) Skip 10 Back');
      repeat
        window (3,11,78,22);
        textcolor (Lightgray);
        gotoxy (20,4); write (' '); gotoxy (20,4);
        repeat read (kbd,ch); until ch in ['F','f','L','l','N','n','P','p','Q','q','+','-','E','e'];
        if ch in ['Q','q'] then
          begin end
        else
          begin
            case ch of
              'F','f'   :  begin
                             tc := 1;
                             seek (trnfile, tc - 1);
                           end;
              'L','l'   :  begin
                             tc := tt;
                             seek (trnfile, tc - 1);
                           end;
              'N','n'   :  begin
                             tc := tc + 1;
                             if tc > tt then tc := tt;
                             seek (trnfile, tc - 1);
                           end;
              'P','p'   :  begin
                             tc := tc - 1;
                             if tc = 0 then tc := 1;
                             seek (trnfile, tc - 1);
                           end;
              '+'       :  begin
                             tc := tc + 10;
                             if tc > tt then tc := tt;
                             seek (trnfile, tc - 1);
                           end;
              '-'       :  begin
                             tc := tc - 10;
                             if tc <= 0 then tc := 1;
                             seek (trnfile, tc - 1);
                           end;
              'E','e'   :  begin
                             if edit_ok then
                               begin
                                 move (real_screen, temp_screen2, 4000);
                                 drawbox (15,6,74,14,lightred+blink,black,'[ EDIT Tran ]',blink_yes);
                                 check_num_h := one_trn.check_no;
                                 to_who_h := one_trn.to_who;
                                 amount_h := one_trn.amount;
                                 memo_h := one_trn.memo;
                                 check_tran_h := one_trn.check_tran;
                                 repeat
                                   textcolor (lightgreen);
                                   gotoxy (2,1);
                                   case one_trn.check_tran of
                                     cdeposit    :  write ('Checking Deposit     ');
                                     cwithdrawl  :  write ('Checking Withdrawl');
                                     cinterest   :  write ('Checking Interest ');
                                     sdeposit    :  write ('Savings Deposit   ');
                                     swithdrawl  :  write ('Savings Withdrawl ');
                                     sinterest   :  write ('Savings Interest  ');
                                   end;  { case }
                                   gotoxy (2,2);  write ('Posting Date : ',one_trn.post_date);
                                   gotoxy (2,3);  write ('Check No.    : ',one_trn.check_no:1,'        ');
                                   gotoxy (2,4);  write ('Written to   : ',one_trn.to_who);
                                   gotoxy (2,5);  write ('Amount       : ',one_trn.amount:1:2,'        ');
                                   gotoxy (2,6);  write ('Memo         : ',one_trn.memo);
                                   { get date }
                                   textcolor (lightcyan);
                                   repeat
                                     temp_date := readdate(17,2,one_trn.post_date);
                                     { get check number }
                                     repeat
                                       gotoxy (17,3);  buflen := 5;  readln (n_check_num);
                                       val (n_check_num, check_num, rc);
                                       if rc <> 0 then
                                         begin
                                           gotoxy (5,7);
                                           writeln ('Error : Numeric input only.');
                                         end;
                                     until rc = 0;
                                     gotoxy (5,7); clreol;
                                     if check_num = 0 then check_num := check_num_h;
                                     { get to_who }
                                      gotoxy (17,4);  buflen := 40; readln (to_whom);
                                     if to_whom = '' then to_whom := to_who_h;
                                     { get amount }
                                     repeat
                                       gotoxy (17,5);  buflen := 8;  readln (n_amount);
                                       if n_amount = '' then
                                         begin
                                           rc := 0;
                                           new_amount := amount_h
                                         end
                                       else
                                         begin
                                           val (n_amount, new_amount, rc);
                                           if rc <> 0 then
                                             begin
                                               gotoxy (5,7);
                                               writeln ('Error in Amount at position ',rc:1);
                                             end;
                                         end;
                                     until rc = 0;
                                     gotoxy (5,7); clreol;
                                     { get memo }
                                     gotoxy (17,6);  buflen := 30; readln (new_memo);
                                     if new_memo = '' then new_memo := memo_h;
                                     while length(new_memo) < 30 do new_memo := new_memo + ' ';
                                     while length(to_whom) < 40 do to_whom := to_whom + ' ';
                                     gotoxy (5,7);   write ('Is this check right  (Y/N)  ');
                                     repeat read (kbd, ch2); until ch2 in yes_no;
                                     case ch2 of
                                       'N','n'  :  begin
                                                     gotoxy (5,7);
                                                     write ('Do you want to EXIT (Y/N)  ');
                                                     repeat read (kbd, ch1); until ch1 in yes_no;
                                                   end;
                                       'Y','y'  :  ch1 := 'N';
                                    end; { case }
                                  until (ch2 in ['Y','y']) or (ch1 in ['Y','y']);
                                  if ch2 in ['Y','y'] then
                                    begin
                                      with one_trn do
                                        begin
                                          post_date := temp_date;
                                          check_no  := check_num;
                                          to_who    := to_whom;
                                          amount    := new_amount;
                                          memo      := new_memo;
                                          check_tran := check_tran_h;
                                          cleared    := false;
                                        end; { with }
                                      seek (trnfile, tc - 1);
                                      write (trnfile, one_trn);
                                    end;
                                    gotoxy (5,7);
                                  if ch1 in ['y','Y'] then
                                    begin end
                                  else
                                    begin
                                      write ('Do you want to EXIT (Y/N)  ');
                                      repeat read (kbd, ch1); until ch1 in yes_no;
                                    end;
                                 until ch1 in ['y','Y'];
                                 move (temp_screen2, real_screen, 4000);
                               end
                           end
            end; { case }
            if ch in ['E','e'] then
              begin end
            else
              begin
                read (trnfile, one_trn);
                edit_ok := true;
                gotoxy (15,5); writeln ('Transaction Number ',tc:1,'        ');
                gotoxy (15,6);
                case one_trn.check_tran of
                  cdeposit  :  write ('Checking Deposit     ');
                  cwithdrawl  :  write ('Checking Withdrawl');
                  cinterest   :  write ('Checking Interest ');
                  sdeposit    :  write ('Savings Deposit   ');
                  swithdrawl  :  write ('Savings Withdrawl ');
                  sinterest   :  write ('Savings Interest  ');
                end;  { case }
                gotoxy (15,7);  write ('Posting Date : ',one_trn.post_date);
                gotoxy (15,8);  write ('Check No.    : ',one_trn.check_no:1,'        ');
                gotoxy (15,9);  write ('Written to   : ',one_trn.to_who);
                gotoxy (15,10); write ('Amount       : ',one_trn.amount:1:2,'        ');
                gotoxy (15,11); write ('Memo         : ',one_trn.memo);
              end;
          end;
      until ch in ['Q','q'];
    end;
  move (temp_screen, real_screen, 4000);
end;

procedure main_options;
begin
  repeat
    drawbox (1,15,80,24,lightcyan,black,'[ Main Menu ]',blink_yes);
    writeln (' Options :');
    writeln ('           1)  Add Transactions           4)  Show Balance Sheet');
    writeln ('           2)  Clear Transactions         5)  Print Summary ');
    writeln ('           3)  Change Transaction File    6)  Browse Transaction File');
    writeln ('                                          7)  Exit PC-Check');
    write   ('                  Your choice ? ');
    repeat
      read (kbd,ch);
    until ch in ['1'..'7'];
    drawbox_ibm (1,15,80,24,lightcyan,black,'[ Main Menu ]',blink_no);
    case ch of
      '1'      : Add_a_trn;
      '4'      : Balance_sheet;
      '2'      : clear_entries;
      '5'      : Summary;
      '3'      : open_files;
      '6'      : Browse;
      '7'      : big_exit;
    end;
  until done;
end;

procedure Opening_screen;
begin
  screen_off;
  drawbox (2,1,79,24,white,black,'',blink_no);
  writeln;
  writeln('       PC-Check Copyright (c)  The Forbin Project and John Friel III');
  writeln;
  writeln('       If you find this program of value,  the Forbin Project requests');
  writeln('       a donation of  only $5.00.   Those that do donate will  receive');
  writeln('       published announcements for future enhancements to PC-Check and');
  writeln('       other programs written by the Forbin Project.  PC-Check may  be');
  writeln('       transferred  to  other people  under two (2) conditions;   that');
  writeln('       there is NO CHARGE  for the copy(s) and that the source program');
  writeln('       not be modified in  any way, shape or form.');
  writeln('       The  user   may   modify  the   source  code  to  suit  his  or');
  writeln('       her own personal tastes.    All rights  reserved by the  Forbin');
  writeln('       Project.  Please keep an unmodified  copy  around just for this');
  writeln('       purpose.  For  more  information   on  this  program  or   more');
  writeln('       detailed information on interfacing  TURBO Pascal  with the IBM');
  writeln('       PC  or  Compatibles,  please write to the Forbin Project at :');
  writeln;
  writeln('                          The Forbin Project');
  writeln('                          John Friel III');
  writeln('                          715 Walnut Street');
  writeln('                          Cedar Falls, Iowa  50613');
  screen_on;
  repeat until keypressed;
  read (kbd,ch);
  window (1,1,80,24);
  clrscr;
end;


begin    {Check_book}
  opening_screen;
  init;
  open_files;
  main_options;
end.